SUBROUTINE MarkOrderBeginning &
!
(orders, flowDirection, orderBeginning)
IMPLICIT NONE
!Arguments with intent in:
TYPE(grid_integer),INTENT(in):: orders
TYPE(grid_integer),INTENT(in):: flowDirection
!Arguments with intent out
TYPE(grid_integer),INTENT(inout):: orderBeginning
LOGICAL :: outlet
INTEGER :: row,col !current cell
INTEGER :: iDown, jDown !downstream cell
INTEGER :: reachOrder
INTEGER :: maxPathOrder
INTEGER :: i,j
!- End of header --------------------------------------------------------------
DO j=1,orderBeginning%jdim
DO i=1,orderBeginning%idim
IF(CellIsSpring(i,j,flowDirection)) THEN !found a spring
orderBeginning%mat(i,j) = 1
row = i
col = j
outlet = .FALSE.
reachOrder = 1
DO WHILE (.NOT. outlet) ! follow the reach till the outlet
CALL DownstreamCell(row,col,flowDirection%mat(row,col),iDown,jDown)
outlet = CheckOutlet (row,col,iDown,jDown,flowDirection)
IF (.NOT. outlet) THEN
IF(orders%mat(iDown,jDown) == reachOrder + 1) THEN
!found the beginning of a reach of increased order
reachOrder = reachOrder + 1
orderBeginning%mat(iDown,jDown) = reachOrder
ENDIF
ENDIF
row = iDown
col = jDown
END DO
ENDIF
ENDDO
ENDDO
!-----------remove duplicates------------
DO j=1,orderBeginning%jdim ! scan entire grid
DO i=1,orderBeginning%idim
IF(CellIsSpring(i,j,flowDirection)) THEN !found a spring
row = i
col = j
outlet = .FALSE.
maxPathOrder = 1
DO WHILE (.NOT. outlet) ! follow the reach till the outlet
CALL DownstreamCell(row,col,flowDirection%mat(row,col),iDown,jDown)
outlet = CheckOutlet (row,col,iDown,jDown,flowDirection)
IF (.NOT. outlet) THEN
IF(orderBeginning%mat(iDown,jDown) <= maxPathOrder) THEN
!only one point where a N order reach begins is possible
orderBeginning%mat(iDown,jDown) = 0
ELSEIF (orderBeginning%mat(iDown,jDown) > maxPathOrder) THEN
maxPathOrder = orderBeginning%mat(iDown,jDown)
ENDIF
ENDIF
row = iDown
col = jDown
END DO
ENDIF
ENDDO
ENDDO
RETURN
END SUBROUTINE MarkOrderBeginning